home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / aclock / frmabout.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-09-04  |  9.2 KB  |  207 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "About KF4ZPB Clock"
  5.    ClientHeight    =   1320
  6.    ClientLeft      =   48
  7.    ClientTop       =   336
  8.    ClientWidth     =   5736
  9.    Icon            =   "frmAbout.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   1320
  14.    ScaleWidth      =   5736
  15.    ShowInTaskbar   =   0   'False
  16.    StartUpPosition =   2  'CenterScreen
  17.    Tag             =   "About KF4ZPB Web Browser"
  18.    Begin VB.CommandButton Command1 
  19.       Caption         =   "Support &Info."
  20.       Height          =   252
  21.       Left            =   4440
  22.       TabIndex        =   4
  23.       Top             =   840
  24.       Width           =   1212
  25.    End
  26.    Begin VB.CommandButton Exit 
  27.       Caption         =   "&OK"
  28.       Default         =   -1  'True
  29.       Height          =   252
  30.       Left            =   4440
  31.       TabIndex        =   2
  32.       Top             =   120
  33.       Width           =   1212
  34.    End
  35.    Begin VB.CommandButton SysInfo 
  36.       Caption         =   "&System Info."
  37.       Height          =   252
  38.       Left            =   4440
  39.       TabIndex        =   1
  40.       Top             =   480
  41.       Width           =   1212
  42.    End
  43.    Begin VB.Label lblVersion 
  44.       Alignment       =   2  'Center
  45.       BackColor       =   &H00FF8080&
  46.       Caption         =   "Version"
  47.       BeginProperty Font 
  48.          Name            =   "Arial"
  49.          Size            =   10.2
  50.          Charset         =   0
  51.          Weight          =   400
  52.          Underline       =   0   'False
  53.          Italic          =   0   'False
  54.          Strikethrough   =   0   'False
  55.       EndProperty
  56.       Height          =   228
  57.       Left            =   120
  58.       TabIndex        =   5
  59.       Tag             =   "Version"
  60.       Top             =   120
  61.       Width           =   4212
  62.    End
  63.    Begin VB.Label Label2 
  64.       Alignment       =   2  'Center
  65.       BackColor       =   &H00FF8080&
  66.       Caption         =   $"frmAbout.frx":0BC2
  67.       Height          =   612
  68.       Left            =   120
  69.       TabIndex        =   3
  70.       Top             =   600
  71.       Width           =   4212
  72.    End
  73.    Begin VB.Label lblDescription 
  74.       Alignment       =   2  'Center
  75.       BackColor       =   &H8000000E&
  76.       Caption         =   "Description"
  77.       BeginProperty Font 
  78.          Name            =   "Arial"
  79.          Size            =   10.2
  80.          Charset         =   0
  81.          Weight          =   400
  82.          Underline       =   0   'False
  83.          Italic          =   0   'False
  84.          Strikethrough   =   0   'False
  85.       EndProperty
  86.       ForeColor       =   &H00000000&
  87.       Height          =   228
  88.       Left            =   120
  89.       TabIndex        =   0
  90.       Tag             =   "App Description"
  91.       Top             =   360
  92.       Width           =   4212
  93.    End
  94. Attribute VB_Name = "frmAbout"
  95. Attribute VB_GlobalNameSpace = False
  96. Attribute VB_Creatable = False
  97. Attribute VB_PredeclaredId = True
  98. Attribute VB_Exposed = False
  99. ' Reg Key Security Options...
  100. Const KEY_ALL_ACCESS = &H2003F
  101.                                           
  102. ' Reg Key ROOT Types...
  103. Const HKEY_LOCAL_MACHINE = &H80000002
  104. Const ERROR_SUCCESS = 0
  105. Const REG_SZ = 1                         ' Unicode nul terminated string
  106. Const REG_DWORD = 4                      ' 32-bit number
  107. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  108. Const gREGVALSYSINFOLOC = "MSINFO"
  109. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  110. Const gREGVALSYSINFO = "PATH"
  111. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  112. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  113. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  114. Private Sub Command1_Click()
  115. frmSupport.Show
  116. End Sub
  117. Private Sub Form_Load()
  118.     lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  119.     lblDescription.Caption = App.FileDescription
  120. End Sub
  121. Private Sub Exit_Click()
  122.     Unload Me
  123. End Sub
  124. Public Sub StartSysInfo()
  125.     On Error GoTo SysInfoErr
  126.         Dim rc As Long
  127.         Dim SysInfoPath As String
  128.         
  129.         ' Try To Get System Info Program Path\Name From Registry...
  130.         If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  131.         ' Try To Get System Info Program Path Only From Registry...
  132.         ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  133.                 ' Validate Existance Of Known 32 Bit File Version
  134.                 If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  135.                         SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  136.                         
  137.                 ' Error - File Can Not Be Found...
  138.                 Else
  139.                         GoTo SysInfoErr
  140.                 End If
  141.         ' Error - Registry Entry Can Not Be Found...
  142.         Else
  143.                 GoTo SysInfoErr
  144.         End If
  145.         
  146.         Call Shell(SysInfoPath, vbNormalFocus)
  147.         
  148.         Exit Sub
  149. SysInfoErr:
  150.         MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  151. End Sub
  152. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  153.         Dim i As Long                                           ' Loop Counter
  154.         Dim rc As Long                                          ' Return Code
  155.         Dim hKey As Long                                        ' Handle To An Open Registry Key
  156.         Dim hDepth As Long                                      '
  157.         Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  158.         Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  159.         Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  160.         '------------------------------------------------------------
  161.         ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  162.         '------------------------------------------------------------
  163.         rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  164.         
  165.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  166.         
  167.         tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  168.         KeyValSize = 1024                                       ' Mark Variable Size
  169.         
  170.         '------------------------------------------------------------
  171.         ' Retrieve Registry Key Value...
  172.         '------------------------------------------------------------
  173.         rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  174.                                                 
  175.         If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  176.         
  177.         If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
  178.                 tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
  179.         Else                                                    ' WinNT Does NOT Null Terminate String...
  180.                 tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
  181.         End If
  182.         '------------------------------------------------------------
  183.         ' Determine Key Value Type For Conversion...
  184.         '------------------------------------------------------------
  185.         Select Case KeyValType                                  ' Search Data Types...
  186.         Case REG_SZ                                             ' String Registry Key Data Type
  187.                 KeyVal = tmpVal                                     ' Copy String Value
  188.         Case REG_DWORD                                          ' Double Word Registry Key Data Type
  189.                 For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  190.                         KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  191.                 Next
  192.                 KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
  193.         End Select
  194.         
  195.         GetKeyValue = True                                      ' Return Success
  196.         rc = RegCloseKey(hKey)                                  ' Close Registry Key
  197.         Exit Function                                           ' Exit
  198.         
  199. GetKeyError:    ' Cleanup After An Error Has Occured...
  200.         KeyVal = ""                                             ' Set Return Val To Empty String
  201.         GetKeyValue = False                                     ' Return Failure
  202.         rc = RegCloseKey(hKey)                                  ' Close Registry Key
  203. End Function
  204. Private Sub SysInfo_Click()
  205. Call StartSysInfo
  206. End Sub
  207.